Libris Britannia 4/science library(b).zip/science library(b)/PROGRAMM/DB_CLIPP/1159.ZIP/REPCALDT.PRG

Text File | 1986-12-08 | 3KB | 161 lines

RNUM=RECNO()
ENDREC=RECCOUNT()
GO RNUM
CLEAR
DO CASE
 CASE ENDREC # 1
  @ 1,7+INT(LOG(ENDREC)/LOG(10))+INT(LOG(RECNO())/LOG(10)) SAY ENDREC
  ??' records.  '
  ??'Data base in use:  '
  ?? OSS
  @ 1,2+INT(LOG(RECNO())/LOG(10)) SAY RECNO()
  ??' of '
  @ 1,0 SAY 'Record No.'
  DO CASE
   CASE RECNO()=ENDREC
    ?'End of listing'
   CASE RECNO()=1
    ?'Beginning of listing'
  ENDCASE
   CASE ENDREC=1
    ?'There is only 1 record in this listing.'
ENDCASE
@ 2,41 SAY 'DATE ERROR ===> '
?? CALIBDATE
@ 3,0 SAY INSTNAME
@ 3,23 SAY SERIALNUM
@ 3,40 SAY TVANUMBER
@ 3,57 SAY CALIBDATE
@ 3,70 SAY 'NEXT DATE'
DO CASE
 CASE BY_DATE=100
  @ 5,56 SAY TDREMARK
 CASE BY_DATE=200
  @ 5,58 SAY DREMARK
ENDCASE
@ 6,0 SAY INST_TYPE
@ 6,23 SAY SERIAL_NO
@ 6,40 SAY TVA_NO
@ 6,58 SAY CALIB_DATE
@ 6,70 SAY CAL_DUE_DT
  PT=0
  IF CAT3ABB $ SUBCATID
   ?'/'
   ?? CATEGORY3
   ??'/   '
   PT=1
  ENDIF
  IF SUB1ABB $ SUBCATID
   IF PT=0
    ?'('
    ?? SUBCAT1
    ??')   '
   ELSE
    ??'('
    ?? SUBCAT1
    ??')   '
   ENDIF
  ENDIF
  IF SUB2ABB $ SUBCATID
   IF PT=0
    ?'('
    ?? SUBCAT2
    ??')   '
   ELSE
    ??'('
    ?? SUBCAT2
    ??')   '
   ENDIF
  ENDIF
  IF SUB3ABB $ SUBCATID
   IF PT=0
   ?'('
   ?? SUBCAT3
   ??')   '
   ELSE
   ??'('
   ?? SUBCAT3
   ??')   '
   ENDIF
  ENDIF
@ 9,0 SAY LOCATNAME
??' :  '
?? LOCATION
??'   '
?? CALINTERVL
??' :  '
?? CALIB_INT
??'  months'
DO CASE
 CASE CALIB_INT=99
  @ 9,60 SAY '/'
  ?? CATEGORY2
  ??'/'
 CASE CALIB_INT=0
  @ 9,60 SAY '/'
  ?? CATEGORY3
  ??'/'
ENDCASE
@ 11,0 SAY REMARK
@ 15,0 SAY ' '
?'What is the correct '
?? CALIBDATE
??' ?'
ACCEPT 'Date format:  ##/##/##        DATE:  ' TO CALDAT
?
?'What is the correct '
?? DUEDATE
??' ?'
ACCEPT 'Date format:  ##/##/##        DATE:  ' TO CALDUEDT
?
@ ROW()+1,41 SAY 'month(s)'
@ ROW()-2,79
?
ACCEPT 'What is the correct time interval ?  ' TO CALIBINT
CALIBIN=VAL(LTRIM(TRIM(CALIBINT)))
@ 23,34 SAY 'WORKING . . .'
     CALDAT=UPPER(LTRIM(TRIM(CALDAT)))
     CALDUEDT=UPPER(LTRIM(TRIM(CALDUEDT)))
     DO CASE
       CASE AT('.O.',CALDAT)=1 .OR. AT('.0.',CALDAT)=1
         IF LEN(CALDAT)>3
           REPLACE CALIB_DATE WITH CTOD(LTRIM(RIGHT(CALDAT,LEN(CALDAT)-3)))
         ENDIF
         CALOVER=100
         REPLACE BY_DATE WITH CALOVER
       CASE AT('.PO.',CALDAT)=1 .OR. AT('.P0.', CALDAT)=1
         IF LEN(CALDAT)>4
           REPLACE CALIB_DATE WITH CTOD(LTRIM(RIGHT(CALDAT,LEN(CALDAT)-4)))
         ENDIF
         CALOVER=200
         REPLACE BY_DATE WITH CALOVER
       CASE LEN(CALDAT)#0
         REPLACE CALIB_DATE WITH CTOD(CALDAT)
     ENDCASE
     DO CASE
       CASE AT('.O.',CALDUEDT)=1 .OR. AT('.0.',CALDUEDT)=1
         IF LEN(CALDUEDT)>3
           REPLACE CAL_DUE_DT WITH CTOD(LTRIM(RIGHT(CALDUEDT,LEN(CALDUEDT)-3)))
         ENDIF
         CALOVER=100
         REPLACE BY_DATE WITH CALOVER
       CASE AT('.PO.',CALDUEDT)=1 .OR. AT('.P0.',CALDUEDT)=1
         IF LEN(CALDUEDT)>4
           REPLACE CAL_DUE_DT WITH CTOD(LTRIM(RIGHT(CALDUEDT,LEN(CALDUEDT)-4)))
         ENDIF
         CALOVER=200
         REPLACE BY_DATE WITH CALOVER
       CASE LEN(CALDUEDT)#0
         REPLACE CAL_DUE_DT WITH CTOD(CALDUEDT)
    ENDCASE
    IF LEN(TRIM(CALIBINT))#0
      REPLACE CALIB_INT WITH CALIBIN
    ENDIF
    RETURN